perm filename LOOP.FAI[NEW,LCS]2 blob
sn#153826 filedate 1975-04-09 generic text, type T, neo UTF8
TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
ENTRY SORT2,UPDATE,NEWR
EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
EXTERNAL SC,SCX
DEFINE FIXX(N)
< JUMPGE N,.+5
MOVNS N
FIX N,233000
MOVNS N
CAIA
FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
; DIMENSION N(1)
MM←1 ↔ NN←2 ↔ J←3
LOOP: 0 ; DO 1 NN=I+L,J+L,K
MOVE 1,@4(16)
SUB 1,@3(16) ; MM IS IN 1
MOVE 2,@(16)
ADD 2,@3(16) ;I+L -- NN, 1ST TIME
MOVE 3,@1(16)
ADD 3,@3(16) ;J+L
MOVE 4,@2(16) ;K
HRRZI 5,@5(16) ; ADR. OF N
ADDI 2,-1(5) ; N(NN)
ADDI 3,-1(5)
JUMPL 4,LP3 ; JUMP IF NEG. INCR.
HRRM 1,.+1 ; ADD IN MM
LP1: MOVE 6,(2)
MOVEM 6,(2) ;N(NN)=N(NN+MM)
CAIGE 2,(3)
AOJA 2,LP1
JRA 16,6(16)
LP3: HRRM 1,.+1
LP2: MOVE 6,(2) ;NEG. INCR.
MOVEM 6,(2)
CAILE 2,(3)
SOJA 2,LP2
JRA 16,6(16) ; END
PLACE: 0 ; FUNCTION PLACE(X)
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
FADR 2,XRN+=3999 ;END
MOVMS 2
MOVE 0,.COMM.+=12 ;R11
FSBR 0,2
JRA 16,1(16)
FINDIT: 0 ; FUNCTION FINDIT(N)
SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
HRRZI 2,PTR ; FINDIT=0
ADDI 1,(2) ; L=PWDS(N)
MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
MOVEM 2,PTR+=251 ; SENDS BACK A NUM IN L
HRRZI 3,XRN ;377 FINDIT=-1
ADDI 3,(2) ; END
MOVE 5,(3) ; RN(L+1)
CAME 5,[1.0]
JRST FNEG
MOVE 5,1(3) ;RN(L+2)
CAME 5,.COMM.
FNEG: SETO
JRA 16,1(16)
DPYNEW: 0 ; SUBROUTINE DPYNEW
JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
JUMP [1] ; CALL ACCPOG(1)
MOVE 2,DPY+=4251 ; IF(IGO.GT.0)RETURN
JUMPG 2,DB ; CALL DPYOUT(1)
JSA 16,DPYOUT ; END
JUMP [1]
DB: JRA 16,(16)
MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
MOVE 5,@1(16) ; I
ADD 2,5 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
ADD 2,@2(16) ; DIMENSION R(1)
MOVE 3,-1(2) ; Y=R(JY+I)
MOVM 4,3 ; Z=ABS(Y)
CAMGE 4,[=100.0] ; IF(Z.LT.100.)GO TO 1
JRST MV1
CAML 5,[6]
JRST MV1 ; IF(I.GT.5)GO TO 1
;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
JSA 16,AMOD ; Y=AMOD(Y,100.)
JUMP 3
JUMP [=100.0] ; 0 HAS Y
MOVE 5,@4(16) ; X=Y+W
FADR 5,0
MOVM 6,5 ; Z=Z-ABS(Y)+ABS(X)
MOVM 7,0 ;C PUTS ALL INTO POSITIVE
FSBR 4,7
FADR 4,6
SKIPGE 5 ; IF(X)Z=-Z
MOVNS 4 ; Z
JRST MV2 ; GO TO 2
MV1: FADR 3,@4(16) ;1 Z=Y+W
MOVE 4,3 ; Z NOW IN 4
MV2: HRRZI 3,@(16) ;2 R(L+I)=Z
ADD 3,@3(16)
ADD 3,@1(16)
MOVEM 4,-1(3) ; PUT IT IN R(L+I)
JRA 16,5(16) ; END
MVBX: 0 ; SUBROUTINE MVBX(I)
; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
MOVE 2,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
HRRZI 4,XRN
ADDI 2,(4)
MOVE 3,-1(2) ; R(JY+I)
FSBR 3,.COMM.+5
FMPR 3,.COMM.+=25 ; *RDIS
FADR 3,.COMM.+=9 ; +R8
MOVE 2,@(16)
ADD 2,.COMM.+=24 ; + L
ADDI 2,(4)
MOVEM 3,-1(2) ;R(L+I)
JRA 16,1(16)
JUGGLE: 0 ; SUBROUTINE JUGGLE
; IMPLICIT INTEGER(A-Z)
; REAL PWDS,RN
; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
SOS PTR+=250 ;ITEM=ITEM-1
HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
;C I-IX IS WD CNT OF NEW ITEM
ADD 15,DPY+=4250
MOVE 14,-1(15)
FIXX(14)
ADDI 14,3 ; JX
MOVE 13,PTR+=253 ;JY=IX
MOVE 11,PTR+=252 ; I
SUB 11,13
SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
JUMPL 11,J2751 ;IF(Z)2751,172,751
JUMPE 11,J172
MOVE 5,PTR+=252 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
SUBI 5,1
MOVE 10,DPY+=4250
ADD 10,14
JSA 16,LOOP
JUMP 5
JUMP 10
JUMP [-1]
JUMP 11
JUMP [0]
JUMP XRN
ADD 13,11 ;JY=IX+Z
JRST J172 ;GO TO 172
J2751: ADD 14,DPY+=4250 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
ADD 14,11
MOVE 5,11
ADD 5,PTR+=253
SOS 5
MOVN 10,11
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP 10
JUMP XRN
J172: HRRZI 12,XRN ; 172 J=RN(JY)+2
ADDI 12,(13) ; JY
MOVE 12,-1(12) ;RN(JY)
FIXX(12)
ADDI 12,2 ; J IS IN 12
JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP DPY+=4250 ; MEDIT
JUMP 13 ; JY
JUMP XRN
MOVE 12,PTR+=253 ; I=IX+Z
ADD 12,11 ; Z IS IN 11
MOVEM 12,PTR+=252
MOVE 12,PTR+=250 ; 1751 X=ITEM+1
ADDI 12,1 ; X IS IN 12
HRRZI 13,DPY+=4000 ; JX=WDS(X22+1)-WDS(X22)
ADD 13,DL
MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
SUB 14,-1(13) ;JX IN 14
HRRZI 10,DPY+=4000 ; J=WDS(X+1)-WDS(X)
ADDI 10,(12)
MOVE 7,(10) ;WDS(X+1)
SUB 7,-1(10) ;J IN 7
MOVEM 7,MVBX ; STORE J
SUB 7,14 ; Y=J-JX
MOVE 14,-1(10) ; JX=WDS(X)+Y+1
ADD 14,7
ADDI 14,1 ; JX IN 14
JUMPL 7,J2851 ; IF(Y)2851,182,282
JUMPE 7,J182
MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
ADDI 15,2 ; ARG 1
MOVE 6,-1(13) ; ARG 2
JSA 16,LOOP
JUMP 15
JUMP 6
JUMP [-1]
JUMP 7 ; Y
JUMP [0]
JUMP DPY
JRST J182 ; GO TO 182
J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
ADD 14,7 ;+Y
ADDI 14,1 ; ARG 1
MOVE 5,-1(10) ;WDS(X)
ADD 5,7
ADDI 5,1 ; ARG 2
MOVNM 7,MVBEAM ; -Y IS STORED
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP MVBEAM
JUMP DPY
MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
ADDI 14,1 ; JX IN 14
J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
ADDI 5,1 ;WDS(X22)+1
JSA 16,LOOP
JUMP [1]
JUMP MVBX
JUMP [1]
JUMP 5
JUMP 14
JUMP DPY
MOVE 2,DL ; DO 183 K=X22+1,X
;; HRRZI 5,DPY+=4000 ; 183 WDS(K)=WDS(K)+Y
;; ADD 5,2
HRRZI 3,PTR
ADDI 3,(2)
TLC 11,232000 ; FLOAT Z
FADR 11,11
J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
MOVE 4,(3)
FADR 4,11 ; ADD Z
MOVEM 4,(3) ; PWDS(K)=PWDS(K)+Z
ADDI 3,1 ;UPDATE PWDS AND WDS
J184: JUMPE 7,J185
MOVE 6,(13)
ADD 6,7
MOVEM 6,(13)
ADDI 13,1
J185: CAIGE 2,(12)
AOJA 2,J183
HRRZI 2,DPY+=4000 ;ST(2)=WDS(X)
ADDI 2,(12) ;WDS(X+1) ADR.
MOVE 2,-1(2)
HRRZI 3,DPY
;; AOJ 3,
MOVEM 2,1(3)
SETZM DL ;X22=0
JRA 16,(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
S3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
S2: MOVE 7,6 ; DO 2 K=L,M
;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST S1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K)
;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
S1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,S2
JUMPL 11,S4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
S4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,S3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
XNOTE: 0 ;FUNCTION XNOTE(J)
MOVE 3,@(16) ;COMMON/XRN/RN(4000)
IMULI 3,12 ;DIMENSION R(10,80)
ADDI 3,XRN+=2993 ;EQUIVALENCE (R,RN(3001))
MOVE 2,(3) ;XNOTE=AMOD(R(4,J),100.)
JSA 16,AMOD
JUMP 2
JUMP [=100.0]
JRA 16,1(16) ;END
BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
MOVE 2,@(16) ;C FOR AUTOMATIC BEAMS.
ADDI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
MOVEM 2,@(16) ;J=J+2
MOVE 3,@3(16)
MOVE 4,@1(16)
SUB 4,3 ;L-N
MOVE 5,@2(16)
SUB 5,3 ;K-N
HRRZI 6,SCM
ADDI 6,(2)
TLC 4,232000
FADR 4,4 ;FLOATS IT
MOVEM 4,-2(6) ;V(J-1)=L-N
TLC 5,232000
FADR 5,5 ;FLOATS IT
MOVEM 5,-1(6) ;V(J)=K-N
JRA 16,4(16)
UPDATE: 0 ; SUBROUTINE UPDATE(I)
HRRZI 3,XRN ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
ADD 3,PTR+=252 ;RN(IS)=I
MOVE 2,@(16)
TLC 2,232000 ;FLOAT I
FADR 2,2
MOVEM 2,-1(3)
MOVE 2,PTR+=252
ADD 2,@(16)
ADDI 2,3
MOVEM 2,PTR+=252 ;IS=IS+I+3
JRA 16,1(16)
JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
IK: 0
JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
NEWR: 0 ; SUBROUTINE NEWR
MOVE A,SC+=70 ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
CAIE A,1 ;COMMON/XRN/RN(4000)
JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(20),JX,U,JZ,IRHY,J4,KA,KB,IZ
MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
MOVE JT,PTR+=250 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
MOVEM JT,JIT ;DIMENSION R(10,80)
N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
MOVEM IS,PTR+=252
MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
ADDI JT,1 ;IK=IS
MOVEM JT,PTR+=250 ;JIT=ITEM
MOVEI K,=10 ;1 IS=IK
MOVE IZ,SCX+=31 ;ITEM=JIT+1
IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
N2: HRRZI R,XRN+=2997 ;DO 2 K=1,IZ
ADD R,K ;IF(R(8,K).EQ.9999.)GO TO 2
MOVE R,(R)
CAMN R,[=9999.0]
JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
SETO IEND, ;C JUMP FOR BEAM CONT.
HRRZI L,XRN ;IEND=-1
ADD L,PTR+=252 ;RN(IS+3)=0
SETZM 2(L)
SETZM 1(L) ;RN(IS+2)=0
MOVEI L,=9 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
N3: HRRZI R,XRN+=3000 ;DO 3 L=9,1,-1
ADDI R,(K) ;A=R(L,K)
ADDI R,(L)
MOVE A,-13(R) ;(OCTAL)=-11
JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
JUMPN A,NX3 ;IF(IEND)GO TO 3
JRST NN3
NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
NX4: HRRZI R,XRN
ADD R,PTR+=252 ;RN(IS+L)=A
ADDI R,(L)
MOVEM A,-1(R)
NN3: CAILE L,1 ;3 CONTINUE
SOJA L,N3
CAIGE IEND,3
MOVEI IEND,3
MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
SUBI 15,2
JSA 16,UPDATE ;CALL UPDATE(IEND-2)
JUMP 15
NN2: CAML K,IZ ;2 CONTINUE
JRA 16,(16) ;END
ADDI K,=10
JRST N2
END